This document was prepared on 2021-10-14.
library(tidyverse)
library(patchwork)
library(glmmTMB)
library(report)
library(parameters)
library(modelbased)
library(performance)
library(bayestestR)
library(see)
summary(report::report(sessionInfo()))The analysis was done using the R Statistical language (v4.1.0; R Core Team, 2021) on Windows 10 x64, using the packages ggplot2 (v3.3.5), stringr (v1.4.0), forcats (v0.5.1), tidyr (v1.1.3), readr (v1.4.0), dplyr (v1.0.6), tibble (v3.1.2), purrr (v0.3.4), parameters (v0.14.0.2), performance (v0.7.3.1), see (v0.6.7), modelbased (v0.9.0), bayestestR (v0.10.5), report (v0.3.5), glmmTMB (v1.1.2.3), patchwork (v1.1.1) and tidyverse (v1.3.1).
df <- read.csv("data/data_combined.csv") %>%
mutate(ID = as.factor(ID),
condition = as.factor(condition),
item = as.factor(item),
style = as.factor(style),
instruction = as.factor(instruction))
cat(paste("The data consists of",
report::report_participants(df,
participants = "ID",
sex = "Gender",
age = "Age")))The data consists of 30 participants (Mean age = 21.1, SD = 2.1, range: [18, 25]; 63.3% females)
Note that the chunks generating figures in the code below have some arguments specified in their header, such as fig.width and fig.height, which controls the figure size. These were filled with an eponym argument defined in utils/config.R. We also set the resolution, i.e., dpi, to a low value so that the resulting file is lighter. But don’t forget to crank this value up (to 300-600) to get nice-looking results.
Notice the {.tabset} tag after the section name. This will show the subsections as different tabs (in the html version only, because the other formats are static).
df.plot <- df %>%
group_by(ID, condition, instruction) %>%
summarise(DT_confidence = mean(DT_confidence, na.rm = TRUE),
DT_RT = mean(DT_RT, na.rm = TRUE),
yoni_total = mean(yoni_total, na.rm = TRUE),
BES_total = mean(BES_total, na.rm = TRUE),
HCT_accuracy = mean(HCT_accuracy, na.rm = TRUE),
MAIA_total = mean(MAIA_total, na.rm = TRUE))p <- ggplot(df.plot, aes(yoni_total)) + geom_histogram()
q <- ggplot(df.plot, aes(BES_total)) + geom_histogram()
r <- ggplot(df.plot, aes(yoni_total, BES_total)) + geom_point()
s <- ggplot(df.plot, aes(HCT_accuracy)) + geom_histogram()
t <- ggplot(df.plot, aes(MAIA_total)) + geom_histogram()
u <- ggplot(df.plot, aes(HCT_accuracy, MAIA_total)) + geom_point()
(p + q + r)/(s + t + u) much higher confidence in truth no diff in reaction time in truth or lie not much diff for diff conditions
p <- ggplot(df, aes(DT_confidence)) + geom_density()
q <- ggplot(df, aes(DT_RT)) + geom_density()
r <- ggplot(df, aes(instruction, DT_confidence, fill = condition)) + geom_boxplot()
s <- ggplot(df, aes(instruction, DT_RT, fill = condition)) + geom_boxplot()
(p + q)/(r + s)interesting that the social tests are more correlated with polygraph and vice versa
both yoni and BES do not seem to have effect in social condition, higher yoni/BES increases confidence in truth and decreases confidences in lie
p <- ggplot(df.plot, aes(x = yoni_total, y = DT_confidence, colour = instruction)) +
geom_point() +
geom_smooth(method = "lm") +
facet_wrap(~condition)
q <- ggplot(df.plot, aes(x = BES_total, y = DT_confidence, colour = instruction)) +
geom_point() +
geom_smooth(method = "lm") +
facet_wrap(~condition)
p + qsame effect in both social and polygraph, higher HCT accuracy decreases confidence in truth and increases confidence in lie
ggplot(df.plot, aes(x = HCT_accuracy, y = DT_confidence, colour = instruction)) +
geom_point() +
geom_smooth(method = "lm") +
facet_wrap(~condition)same effect for lie in both social and polygraph, higher MAIA increases confidence higher MAIA increases confidence in lie for social and not polygraph
ggplot(df.plot, aes(x = MAIA_total, y = DT_confidence, colour = instruction)) +
geom_point() +
geom_smooth(method = "lm") +
facet_wrap(~condition)Confidence has a significant impact on RT.
model <- glmmTMB(DT_confidence ~ DT_RT + (1|ID) + (1|item), data = df) # removed trial
parameters(model, effects = "fixed")| Parameter | Coefficient | SE | CI | CI_low | CI_high | z | df_error | p | Effects |
|---|---|---|---|---|---|---|---|---|---|
| (Intercept) | 0.66 | 0.03 | 0.95 | 0.60 | 0.71 | 22.6 | Inf | 0.00 | fixed |
| DT_RT | -0.01 | 0.01 | 0.95 | -0.03 | 0.00 | -2.8 | Inf | 0.01 | fixed |
viz_data <- estimate_relation(model)
ggplot(data = viz_data, aes(x = DT_RT, y = Predicted)) +
geom_point(data = df, aes(x = DT_RT, y = DT_confidence, color = ID), show.legend = FALSE) +
geom_line() +
geom_ribbon(aes(ymin = CI_low, ymax = CI_high), alpha = 0.3)# what's the include_random thing (6.5 vs 6.7)There is a significant interaction of condition and instruction on confidence. The increase in confidence from lie to truth is more in polygraph than social.
model <- glmmTMB(DT_confidence ~ condition*instruction + (1|ID) + (1|item), data = df)
parameters(model, effects = "fixed")| Parameter | Coefficient | SE | CI | CI_low | CI_high | z | df_error | p | Effects |
|---|---|---|---|---|---|---|---|---|---|
| (Intercept) | 0.42 | 0.02 | 0.95 | 0.38 | 0.46 | 19.50 | Inf | 0.00 | fixed |
| conditionSocial | 0.01 | 0.02 | 0.95 | -0.02 | 0.04 | 0.74 | Inf | 0.46 | fixed |
| instructionTRUTH | 0.36 | 0.02 | 0.95 | 0.33 | 0.40 | 22.04 | Inf | 0.00 | fixed |
| conditionSocial:instructionTRUTH | -0.05 | 0.02 | 0.95 | -0.10 | -0.01 | -2.32 | Inf | 0.02 | fixed |
means <- modelbased::estimate_means(model, at = c("condition", "instruction"))
contrasts <- modelbased::estimate_contrasts(model, contrast = c("condition", "instruction"))
ggplot(means, aes(x = instruction, y = Mean, colour = condition)) +
geom_line(aes(group = condition)) +
geom_pointrange(aes(ymin = CI_low, ymax= CI_high))There is no significant interaction of condition and instruction on RT.
model <- glmmTMB(DT_RT ~ condition*instruction + (1|ID) + (1|item), data = df)
parameters(model, effects = "fixed")| Parameter | Coefficient | SE | CI | CI_low | CI_high | z | df_error | p | Effects |
|---|---|---|---|---|---|---|---|---|---|
| (Intercept) | 4.33 | 0.21 | 0.95 | 3.91 | 4.74 | 20.53 | Inf | 0.00 | fixed |
| conditionSocial | -0.41 | 0.07 | 0.95 | -0.54 | -0.28 | -6.10 | Inf | 0.00 | fixed |
| instructionTRUTH | 0.08 | 0.07 | 0.95 | -0.05 | 0.21 | 1.19 | Inf | 0.23 | fixed |
| conditionSocial:instructionTRUTH | -0.02 | 0.10 | 0.95 | -0.20 | 0.17 | -0.19 | Inf | 0.85 | fixed |
means <- modelbased::estimate_means(model, at = c("condition", "instruction"))
ggplot(means, aes(x = instruction, y = Mean, colour = condition)) +
geom_line(aes(group = condition)) +
geom_pointrange(aes(ymin = CI_low, ymax= CI_high))There is no significant interaction of style and instruction on confidence.
model <- glmmTMB(DT_confidence ~ style*instruction + (1|ID) + (1|item), data = df)
parameters(model, effects = "fixed")| Parameter | Coefficient | SE | CI | CI_low | CI_high | z | df_error | p | Effects |
|---|---|---|---|---|---|---|---|---|---|
| (Intercept) | 0.43 | 0.02 | 0.95 | 0.39 | 0.48 | 20.11 | Inf | 0.00 | fixed |
| styleIndirect | -0.01 | 0.02 | 0.95 | -0.05 | 0.02 | -0.90 | Inf | 0.37 | fixed |
| instructionTRUTH | 0.34 | 0.02 | 0.95 | 0.30 | 0.37 | 20.27 | Inf | 0.00 | fixed |
| styleIndirect:instructionTRUTH | 0.00 | 0.02 | 0.95 | -0.04 | 0.05 | 0.09 | Inf | 0.93 | fixed |
means <- modelbased::estimate_means(model, at = c("style", "instruction"))
ggplot(means, aes(x = instruction, y = Mean, colour = style)) +
geom_line(aes(group = style)) +
geom_pointrange(aes(ymin = CI_low, ymax= CI_high))There is no significant interaction of style and instruction on RT.
model <- glmmTMB(DT_RT ~ style*instruction + (1|ID) + (1|item), data = df)
parameters(model, effects = "fixed")| Parameter | Coefficient | SE | CI | CI_low | CI_high | z | df_error | p | Effects |
|---|---|---|---|---|---|---|---|---|---|
| (Intercept) | 3.96 | 0.21 | 0.95 | 3.54 | 4.37 | 18.77 | Inf | 0.00 | fixed |
| styleIndirect | 0.33 | 0.07 | 0.95 | 0.20 | 0.46 | 4.91 | Inf | 0.00 | fixed |
| instructionTRUTH | 0.02 | 0.07 | 0.95 | -0.11 | 0.15 | 0.28 | Inf | 0.78 | fixed |
| styleIndirect:instructionTRUTH | 0.10 | 0.10 | 0.95 | -0.08 | 0.29 | 1.09 | Inf | 0.27 | fixed |
means <- modelbased::estimate_means(model, at = c("style", "instruction"))
ggplot(means, aes(x = instruction, y = Mean, colour = style)) +
geom_line(aes(group = style)) +
geom_pointrange(aes(ymin = CI_low, ymax= CI_high))The full script of executive code contained in this document is reproduced here.
# Set up the environment (or use local alternative `source("utils/config.R")`)
source("https://raw.githubusercontent.com/RealityBending/TemplateResults/main/utils/config.R")
fast <- FALSE # Make this false to skip the chunks
# This chunk is a bit complex so don't worry about it: it's made to add badges to the HTML versions
# NOTE: You have to replace the links accordingly to have working "buttons" on the HTML versions
if (!knitr::is_latex_output() && knitr::is_html_output()) {
cat("
[](https://github.com/RealityBending/TemplateResults)
[](https://realitybending.github.io/TemplateResults/)
[](https://github.com/RealityBending/TemplateResults/raw/main/word_and_pdf/SupplementaryMaterials.docx)
[](https://github.com/RealityBending/TemplateResults/blob/main/word_and_pdf/SupplementaryMaterials.pdf)")
}
library(tidyverse)
library(patchwork)
library(glmmTMB)
library(report)
library(parameters)
library(modelbased)
library(performance)
library(bayestestR)
library(see)
summary(report::report(sessionInfo()))
df <- read.csv("data/data_combined.csv") %>%
mutate(ID = as.factor(ID),
condition = as.factor(condition),
item = as.factor(item),
style = as.factor(style),
instruction = as.factor(instruction))
cat(paste("The data consists of",
report::report_participants(df,
participants = "ID",
sex = "Gender",
age = "Age")))
report::cite_packages(sessionInfo())
df.plot <- df %>%
group_by(ID, condition, instruction) %>%
summarise(DT_confidence = mean(DT_confidence, na.rm = TRUE),
DT_RT = mean(DT_RT, na.rm = TRUE),
yoni_total = mean(yoni_total, na.rm = TRUE),
BES_total = mean(BES_total, na.rm = TRUE),
HCT_accuracy = mean(HCT_accuracy, na.rm = TRUE),
MAIA_total = mean(MAIA_total, na.rm = TRUE))
p <- ggplot(df.plot, aes(yoni_total)) + geom_histogram()
q <- ggplot(df.plot, aes(BES_total)) + geom_histogram()
r <- ggplot(df.plot, aes(yoni_total, BES_total)) + geom_point()
s <- ggplot(df.plot, aes(HCT_accuracy)) + geom_histogram()
t <- ggplot(df.plot, aes(MAIA_total)) + geom_histogram()
u <- ggplot(df.plot, aes(HCT_accuracy, MAIA_total)) + geom_point()
(p + q + r)/(s + t + u)
p <- ggplot(df, aes(DT_confidence)) + geom_density()
q <- ggplot(df, aes(DT_RT)) + geom_density()
r <- ggplot(df, aes(instruction, DT_confidence, fill = condition)) + geom_boxplot()
s <- ggplot(df, aes(instruction, DT_RT, fill = condition)) + geom_boxplot()
(p + q)/(r + s)
p <- ggplot(df.plot, aes(x = yoni_total, y = DT_confidence, colour = instruction)) +
geom_point() +
geom_smooth(method = "lm") +
facet_wrap(~condition)
q <- ggplot(df.plot, aes(x = BES_total, y = DT_confidence, colour = instruction)) +
geom_point() +
geom_smooth(method = "lm") +
facet_wrap(~condition)
p + q
ggplot(df.plot, aes(x = HCT_accuracy, y = DT_confidence, colour = instruction)) +
geom_point() +
geom_smooth(method = "lm") +
facet_wrap(~condition)
ggplot(df.plot, aes(x = MAIA_total, y = DT_confidence, colour = instruction)) +
geom_point() +
geom_smooth(method = "lm") +
facet_wrap(~condition)
model <- glmmTMB(DT_confidence ~ DT_RT + (1|ID) + (1|item), data = df) # removed trial
parameters(model, effects = "fixed")
viz_data <- estimate_relation(model)
ggplot(data = viz_data, aes(x = DT_RT, y = Predicted)) +
geom_point(data = df, aes(x = DT_RT, y = DT_confidence, color = ID), show.legend = FALSE) +
geom_line() +
geom_ribbon(aes(ymin = CI_low, ymax = CI_high), alpha = 0.3)
# what's the include_random thing (6.5 vs 6.7)
model <- glmmTMB(DT_confidence ~ condition*instruction + (1|ID) + (1|item), data = df)
parameters(model, effects = "fixed")
means <- modelbased::estimate_means(model, at = c("condition", "instruction"))
contrasts <- modelbased::estimate_contrasts(model, contrast = c("condition", "instruction"))
ggplot(means, aes(x = instruction, y = Mean, colour = condition)) +
geom_line(aes(group = condition)) +
geom_pointrange(aes(ymin = CI_low, ymax= CI_high))
model <- glmmTMB(DT_RT ~ condition*instruction + (1|ID) + (1|item), data = df)
parameters(model, effects = "fixed")
means <- modelbased::estimate_means(model, at = c("condition", "instruction"))
ggplot(means, aes(x = instruction, y = Mean, colour = condition)) +
geom_line(aes(group = condition)) +
geom_pointrange(aes(ymin = CI_low, ymax= CI_high))
model <- glmmTMB(DT_confidence ~ style*instruction + (1|ID) + (1|item), data = df)
parameters(model, effects = "fixed")
means <- modelbased::estimate_means(model, at = c("style", "instruction"))
ggplot(means, aes(x = instruction, y = Mean, colour = style)) +
geom_line(aes(group = style)) +
geom_pointrange(aes(ymin = CI_low, ymax= CI_high))
model <- glmmTMB(DT_RT ~ style*instruction + (1|ID) + (1|item), data = df)
parameters(model, effects = "fixed")
means <- modelbased::estimate_means(model, at = c("style", "instruction"))
ggplot(means, aes(x = instruction, y = Mean, colour = style)) +
geom_line(aes(group = style)) +
geom_pointrange(aes(ymin = CI_low, ymax= CI_high))report::cite_packages(sessionInfo())